#!/usr/bin/perl -wc

package RFCMail::PackIt::Type::Scalar;

use strict;
use warnings;
use bytes;

use RFCMail::PackIt::Access;

# Type u32

sub read_u32 {
    return (unpack("N", $_[0]->read(4)));
}

sub write_u32 {
    my $access = shift;
    $access->write(pack('N*', @_));
}

# Type u8

sub read_u8 {
    return (unpack("C", $_[0]->read(1)));
}

sub write_u8 {
    my $access = shift;
    $access->write(pack('C*', @_));
}

# Type var8

sub read_var8 {
    return ($_[0]->read(&read_u8));
}

sub write_var8 {
    my $access = shift;
    $access->write(pack('(C/a*)*', @_));
}

# Type var

sub read_var {
    return ($_[0]->remainder);
}

sub write_var {
    my $access = shift;
    $access->write(@_);
}

# Type domain

sub read_domain {
    my (@dn, $part);
    while ($part = &read_var8) {
	die "over-length label in domain name"
	    if length($part) > 63;
	$part =~ /^[[:print:]]+$/
	    or die "non-printing character in domain name";
	$part =~ /^[^.]+$/
	    or die "embedded period in domain name";
	push @dn, $part;
    }
    my $domain = join('.', @dn);
    die "domain name too long"
	if length($domain) > 253;
    return ($domain);
}

sub write_domain {
    my $access = shift;
    for (@_) {
	die "attempt to write over-length domain name"
	    if length > 253;
	/^[[:print:]]*$/
	    or die "attempt to write domain name with non-printing characters";
	/^(?:(?:[^.]{1,63})(?:\.[^.]{1,63})*)?$/
	    or die "attempt to write malformed domain name";
	write_var8($access, split(/\./, $_), "");
    }
}

# Type void

sub read_void {
    return (undef);
}

sub write_void {}

# Type name to function mapping

sub import {
    my ($module, @types) = @_;
    my %map =
	(
	 u32 => [\&read_u32, \&write_u32],
	 u8 => [\&read_u8, \&write_u8],
	 var8 => [\&read_var8, \&write_var8],
	 var => [\&read_var, \&write_var],
	 domain => [\&read_domain, \&write_domain],
	 void => [\&read_void, \&write_void],
	);
    @types = keys(%map)
	unless (@types);
    for (@types) {
	register_type RFCMail::PackIt::Access $_, @{$map{$_}};
    }
}

1;
